
#|____________________________________________________________________
 |
 |         RMDS.LSP - Replicated Multidimensional Scaling
 |              Copyright (c) 1997, Forrest W. Young
 |                         VISUALIZATION
 |____________________________________________________________________
 |#


(defmeth rmds-model-proto :mds-t-change-plot (&optional (stream t))
  (let ((num-dims (send self :dimensions))
        (num-mats (length (send self :matrices-numbers)))
        (t-changep (plot-points 
                    (iseq (length (send self :t-change-list))) 
                    (send self :t-change-list)
                    :show nil
                    :title "Transformation Change Plot"
                    :variable-labels (list "Iteration" "T-Change"))))
    (send t-changep :margin 0 17 0 0)
    (send t-changep :add-overlay 
          (send vista-graph-overlay-proto 
                :new :mouse-mode nil :new-x nil :new-y nil))
    (send t-changep :showing-labels t)
    (send t-changep :point-label 
          (iseq (send t-changep :num-points))
          (mapcar #'(lambda (st) (format nil "~5,4f" st)) 
                  (send self :t-change-list)))
    (send t-changep :point-state 0 'selected)
    (send t-changep :use-color t)
    (send t-changep :point-color 0 'red)
    (send t-changep :mouse-mode 'brushing)
    (send t-changep :range 0 0 5)
    (send t-changep :x-axis t t 6)
    (send t-changep :menu nil)
    (send t-changep :legend2 "Transformation Change Plot")
    (send t-changep :add-lines 
          (iseq (length (send self :t-change-list))) 
          (send self :t-change-list)
          :color 'red)
    (send t-changep :adjust-to-data)

    (defmeth t-changep :redraw ()
      (let* ((maxy (max (send t-changep :point-coordinate 1 
                              (iseq (send t-changep :num-points)))))
             (gnrx nil)
             )
        (when (> (send self :num-points) (second (send self :range 0)))
              (setf gnrx 
                    (get-nice-range 0 (+ 5 (second (send self :range 0))) 5))
              (send self :range 0 (first gnrx) (second gnrx) :draw nil)
              (send self :x-axis t t (third gnrx) :draw nil))
        (send t-changep :range 1 0  (* .1 (ceiling (* 10 maxy))) :draw nil)
        (send t-changep :y-axis t t (1+   (ceiling (* 10 maxy))) :draw nil)
        (call-next-method)))

    (defmeth t-changep :add-lines-with-points (&key (color 'black))
      (let* ((ps (send self :num-points)))
        (send self :clear-lines :draw nil)
        (send self :add-lines (send self :point-coordinate 0 (iseq ps))
              (send self :point-coordinate 1 (iseq ps)) :color color)
        (send self :redraw)))

    (defmeth t-changep :plot-help ()
      (plot-help-window (strcat "Help for " (send self :title)))
      (paste-plot-help (format nil "The Stress plot shows the fit of the multidimensional scaling model to the dissimilarity data."))
      (when (> num-mats 1)
            (paste-plot-help (format nil " Since there are ~d matrices of data, the fit is to the root-mean-squared data matrix."num-mats)))
      (paste-plot-help (format nil " The fit is shown for a ~d-dimensional model, since this is the dimensionality you specified. The fit is shown for each iteration. Initially, there is just one value shown.~2%" num-dims))

      (if (= 1 (send t-changep :num-points))
          (paste-plot-help (format nil "Currently, the fit is shown for just the initial solution. You can start the iterative process by clicking on the ITERATE button in the STIMULUS SPACE window~2%"))
          (paste-plot-help (format nil "Currently, the fit is shown for ~d iterations. Additional iterations can be performed by clicking on the ITER button in the STIMULUS SPACE window.~2%"(send stressp :num-points))))

      (paste-plot-help (format nil "The Stress plot is used to help you decide whether more iterations are needed to obtain a stable solution. As the iterations proceed, the positions of the stimulus points, as shown in the STIMULUS PLANE MATRIX, STIMULUS SPACE and STIMULUS PLANE plots, become stable, and the Stress value declines slowly, if at all. When this happens, the iterative process has converged on a stable solution, which is ready for interpretation.~2%"))
      (paste-plot-help (format nil "Unfortunately, it is not possible to say what value of Stress represents a good fit. It is known that Stress is effected artifactually by the number of stimuli and the number of dimensions, making it essentially impossible to say whether a particular value is good or bad. You must rely instead on whether the stimulus space, as shown in the STIMULUS PLANE MATRIX, STIMULUS SPACE and STIMULUS PLANE plots, is interpretable."))
      (show-plot-help))

    t-changep ))



(defmeth rmds-model-proto :mds-s-change-plot (&optional (stream t))
  (let* ((num-dims (send self :dimensions))
        (num-mats (length (send self :matrices-numbers)))
        (stress-list (send self :stress-list))
        (s-change-list (- (select stress-list (iseq (- (length stress-list) 1)))
                          (select stress-list (iseq 1 (1- (length stress-list))))))
                     
        )
    (setf s-changep (plot-points 
                     (iseq (length s-change-list))
                     s-change-list
                     :show nil
                     :title "Stress Change Plot"
                     :variable-labels (list "Iteration" "S-Change")))
    (send s-changep :margin 0 17 0 0)
    (send s-changep :add-overlay 
          (send vista-graph-overlay-proto 
                :new :mouse-mode nil :new-x nil :new-y nil))
    (send s-changep :showing-labels t)
    ;(send s-changep :point-label 0 
           ;     (format nil "~5,4f" (send stressp :point-coordinate 1 0)))
    (send s-changep :point-label 
          (iseq (length s-change-list))
          (mapcar #'(lambda (st) (format nil "~5,4f" st)) 
                  s-change-list))
    (send s-changep :point-state 0 'selected)
    (send s-changep :use-color t)
    (send s-changep :point-color 0 'red)
    (send s-changep :mouse-mode 'brushing)
    (send s-changep :range 0 0 5)
    (send s-changep :x-axis t t 6)
    (send s-changep :menu nil)
    (send s-changep :legend2 "Stress Change Plot")
    (send s-changep :add-lines 
          (iseq (length s-change-list))
          s-change-list 
          :color 'red)
    (send s-changep  :adjust-to-data)

    (defmeth s-changep :redraw ()
      (let* ((maxy (max (send s-changep :point-coordinate 1 
                              (iseq (send s-changep :num-points)))))
             (gnrx nil)
             )
        (when (> (send self :num-points) (second (send self :range 0)))
              (setf gnrx 
                    (get-nice-range 0 (+ 5 (second (send self :range 0))) 5))
              (send self :range 0 (first gnrx) (second gnrx) :draw nil)
              (send self :x-axis t t (third gnrx) :draw nil))
        (send s-changep :range 1 0  (* .1 (ceiling (* 10 maxy))) :draw nil)
        (send s-changep :y-axis t t (1+   (ceiling (* 10 maxy))) :draw nil)
        (call-next-method)))

    (defmeth s-changep :add-lines-with-points (&key (color 'black))
      (let* ((ps (send self :num-points)))
        (send self :clear-lines :draw nil)
        (send self :add-lines (send self :point-coordinate 0 (iseq ps))
              (send self :point-coordinate 1 (iseq ps)) :color color)
        (send self :redraw)))

    (defmeth s-changep :plot-help ()
      (plot-help-window (strcat "Help for " (send self :title)))
      (paste-plot-help (format nil "The Stress plot shows the fit of the multidimensional scaling model to the dissimilarity data."))
      (when (> num-mats 1)
            (paste-plot-help (format nil " Since there are ~d matrices of data, the fit is to the root-mean-squared data matrix."num-mats)))
      (paste-plot-help (format nil " The fit is shown for a ~d-dimensional model, since this is the dimensionality you specified. The fit is shown for each iteration. Initially, there is just one value shown.~2%" num-dims))

      (if (= 1 (send s-changep :num-points))
          (paste-plot-help (format nil "Currently, the fit is shown for just the initial solution. You can start the iterative process by clicking on the ITERATE button in the STIMULUS SPACE window~2%"))
          (paste-plot-help (format nil "Currently, the fit is shown for ~d iterations. Additional iterations can be performed by clicking on the ITER button in the STIMULUS SPACE window.~2%"(send stressp :num-points))))

      (paste-plot-help (format nil "The Stress plot is used to help you decide whether more iterations are needed to obtain a stable solution. As the iterations proceed, the positions of the stimulus points, as shown in the STIMULUS PLANE MATRIX, STIMULUS SPACE and STIMULUS PLANE plots, become stable, and the Stress value declines slowly, if at all. When this happens, the iterative process has converged on a stable solution, which is ready for interpretation.~2%"))
      (paste-plot-help (format nil "Unfortunately, it is not possible to say what value of Stress represents a good fit. It is known that Stress is effected artifactually by the number of stimuli and the number of dimensions, making it essentially impossible to say whether a particular value is good or bad. You must rely instead on whether the stimulus space, as shown in the STIMULUS PLANE MATRIX, STIMULUS SPACE and STIMULUS PLANE plots, is interpretable."))
      (show-plot-help))

    s-changep ))



(defmeth rmds-model-proto :use-new-point (i xvar yvar xscore yscore )
  (let* (
         (plots (combine (send *current-spreadplot* :plot-matrix)));pv
         (sm (second plots));pv
         (pp (third plots));pv
         (sp (fourth plots));pv
         (stressp (fifth plots));pv                               
         (scores (list xscore yscore))
         (cur-vars (list xvar yvar))
         (new-matrix (send self :xmatrix))
         (n (array-dimension (send self :xmatrix) 0))
         (m (array-dimension (send self :xmatrix) 1))
         (copy-old (matrix (list n m) 
                           (copy-list (combine 
                                        (send self :xmatrix))))))
  (send self :old-matrix copy-old)
    (if (eq (send pp :mouse-mode) 'relocate-points)
        (setf k (select i 0))
        (setf k i))
    (send pp :point-coordinate xvar k xscore)
    (send pp :point-coordinate yvar k yscore)
    (send pp :redraw)
    
    (send sp :point-coordinate xvar k xscore)
    (send sp :point-coordinate yvar k yscore)
    (send sp :redraw)
    (send sm :point-coordinate xvar k xscore)
    (send sm :point-coordinate yvar k yscore)
    (send sm :redraw)
  (dotimes (j 2)
             (setf (aref new-matrix
                         k
                         (select cur-vars j))
                   (select scores j)))
    (send self :old-matrix (send self :xmatrix))
    (send self :xmatrix new-matrix)
    (send self :x (send self :xmatrix));pv
    (send self :update-plot-transformed-data);pv
    (send self :stress-list (combine (send self :stress-list) (send self :calc-stress)));start pv
    (send stressp :start-buffering)
    (send stressp :clear-points)
    (send stressp :clear-lines)
    (send stressp :add-points 
          (iseq (length (send self :stress-list)))
          (send self :stress-list)
          :draw nil
          :color 'red);pv
      (send stressp :add-lines 
          (iseq (length (send self :stress-list)))
          (send self :stress-list)
          :draw nil
          :color 'red);pv

    (send stressp :point-label (iseq (length (send self :stress-list)))
          (mapcar '(lambda (el)
                     (format nil "~5,4f" el))
                  (send self :stress-list)))
                        
   ; (send stressp :add-lines-with-points :color 'red)
    (send stressp :point-state (- (length (send self :stress-list)) 2) 'normal)
    (send stressp :point-state (- (length (send self :stress-list)) 1) 'selected)
    (send stressp :adjust-to-data);pv
    (send stressp :redraw)
    (send stressp :buffer-to-screen);end pv
    ))

(defmeth rmds-model-proto :new-sm-points ()
  (let* (
         (sm (second (combine (send *current-spreadplot* :plot-matrix))))
         (n (send sm :num-points))
         (symbols (send sm :point-symbol (iseq n)))
         (states (send sm :point-state (iseq n)))
         (colors (send sm :point-color (iseq n))))     
    (send sm :clear :draw nil)
    (send sm :add-points  (col (send self :xmatrix) 
                               (iseq (send self :dimensions)))
          :point-labels (send self :stimulus-names)     
          :draw nil)
    (send sm :adjust-to-data :draw nil)
    (send sm :point-state (iseq n) states :draw nil)
    (send sm :point-symbol (iseq n) symbols :draw nil)
    (send sm :point-color (iseq n) colors :draw nil)
    (send sm :redraw)))

(defmeth rmds-model-proto :new-sp-points ()
  (let* (
          (sp (fourth (combine (send *current-spreadplot* :plot-matrix))))
         (n (send sp :num-points))
      (symbols (send sp :point-symbol (iseq n)))
      (states (send sp :point-state (iseq n)))
      (colors (send sp :point-color (iseq n))))     
    (send sp :clear-points :draw nil)
    (send sp :add-points  (col (send self :xmatrix) 
                               (iseq (send self :dimensions)))
          :point-labels (send self :stimulus-names)     
          :draw nil)
   ; (send sp :adjust-to-data :draw nil)
    (send sp :point-state (iseq n) states :draw nil)
    (send sp :point-symbol (iseq n) symbols :draw nil)
    (send sp :point-color (iseq n) colors :draw nil)
    (send sp :redraw)))

(defmeth rmds-model-proto :new-pp-points ()
  (let* (
         (pp (third (combine (send *current-spreadplot* :plot-matrix))))
         (n (send pp :num-points))
         (symbols (send pp :point-symbol (iseq n)))
         (states (send pp :point-state (iseq n)))
         (colors (send pp :point-color (iseq n))))
    (send pp :clear :draw nil)
    (send pp :add-points  (col (send self :xmatrix) 
                               (iseq (send self :dimensions)))
          :point-labels (send self :stimulus-names)     
          :draw nil)
    
    (send pp :point-state (iseq n) states :draw nil)
    (send pp :point-symbol (iseq n) symbols :draw nil)
    (send pp :point-color (iseq n) colors :draw nil)
    (send pp :redraw)
    ))
(defmeth rmds-model-proto :calc-stress ()
  (let* (
         (new-matrix (send self :xmatrix))
         (t-data (mapcar #'(lambda (mat)
                             (select mat 
                                     (iseq (array-dimension mat 0))
                                     (iseq (send self :dimensions)))
                             )
                         (send self :t-data)))
           (news (if (= (length t-data) 1)
                   (send self :r-stress new-matrix t-data)
                   (send self :r-stress new-matrix t-data)));pv
          )
    news))
(defmeth rmds-model-proto :calc-stress ()
  (send self :D (distance-matrix (send self :xmatrix)))
  (send self :r-stress (send self :D) (send self :t-data))
  )

(defmeth rmds-model-proto :undo-iterations ()
  (let* ((n (array-dimension (send self :xmatrix) 0))
         (m (array-dimension (send self :xmatrix) 1))
         (prev (matrix (list n m) (copy-list (combine (send self :prev-matrix)))))
         (news (first (send self :prev-stress)))

         )
    (send self :stress-list (combine (send self :stress-list) news));pv
    (send self :old-matrix 
               (matrix (list n m) (copy-list (combine (send self :xmatrix)))))
    (send self :xmatrix prev)
    (send self :x (send self :xmatrix));pv
    (send self :update-plot-transformed-data);pv
    (send self :new-sm-points)
    (send self :new-pp-points)
    (send self :new-sp-points)
   ; (send current-model :stress news) pv
    (send stressp :start-buffering)
    (send stressp :clear-lines)
    (send stressp :clear-points)
    (send stressp :add-points
          (iseq (length (send self :stress-list)))
          (send self :stress-list) :color 'red)
    (send stressp :point-label (- (send stressp :num-points) 1)
          (format nil "~5,4f" news))
    ;(send stressp :add-lines-with-points :color 'red)
    (send stressp :add-lines (iseq (length (send self :stress-list)))
          (send self :stress-list) :color 'red)
    (send stressp :point-state (- (length (send self :stress-list)) 2) 'normal);pv
    (send stressp :point-state (- (length (send self :stress-list)) 1) 'selected);pv
    (send stressp :adjust-to-data)
    (send stressp :redraw)
    (send stressp :buffer-to-screen)
    ))

(defmeth rmds-model-proto :back-just-one ()
  (let* ((n (array-dimension (send self :xmatrix) 0))
         (m (array-dimension (send self :xmatrix) 1))
         (old (matrix (list n m) (copy-list (combine (send self :old-matrix)))))
         (news (second (reverse (send self :stress-list))));pv
         )
    (send self :stress-list (combine (send self :stress-list) news));pv
    (send self 
          :old-matrix 
          (matrix (list n m)
                  (copy-list 
                   (combine 
                    (send self :xmatrix)))))
    (send self :xmatrix old)
    (send self :x (send self :xmatrix));pv
    (send self :update-plot-transformed-data);pv
    (send self :new-sm-points)
    (send self :new-pp-points)
    (send self :new-sp-points)
   ; (send current-model :stress news)
    (send stressp :start-buffering)
    (send stressp :clear-points)
    (send stressp :clear-lines)
    (send stressp :add-points
          (iseq (length (send self :stress-list)))
          (send self :stress-list) :color 'red)
    (send stressp :point-label (iseq (length (send self :stress-list)))
          (mapcar '(lambda (el)
                     (format nil "~5,4f" el))
                  (send self :stress-list)))
    (send stressp :add-lines (iseq (length (send self :stress-list)))
          (send self :stress-list) :color 'red)
    (send stressp :point-state (- (length (send self :stress-list)) 2) 'normal);pv
    (send stressp :point-state (- (length (send self :stress-list)) 1) 'selected);pv
    (send stressp :adjust-to-data)
    (send stressp :redraw)
    (send stressp :buffer-to-screen)))

(defmeth rmds-model-proto :back-to-start ()
  (let* ((n (array-dimension (send self :xmatrix) 0))
         (m (array-dimension (send self :xmatrix) 1))
         (orig (matrix (list n m) (copy-list (combine (send self :orig-matrix)))))
         (news (send self :orig-stress)))
    ;pv
    (send self :old-matrix (matrix (list n m) (copy-list (combine (send self :xmatrix)))))
    (send self :xmatrix orig)
    (send self :x (send self :xmatrix));pv
    (send self :update-plot-transformed-data);pv
    (send self :stress-list (combine (send self :stress-list) (first (send self :stress-list))))
    (send self :new-sm-points)
    (send self :new-pp-points)
    (send self :new-sp-points)
    ;(send current-model :stress news) pv
    (send stressp :start-buffering)
    (send stressp :clear-points)
    (send stressp :clear-lines)
    (send stressp :add-points
          (iseq (length (send self :stress-list)))
          (send self :stress-list) :color 'red)
    (send stressp :point-label (iseq (length (send self :stress-list)))
          (mapcar '(lambda (el)
                     (format nil "~5,4f" el))
                  (send self :stress-list)))
    (send stressp :add-lines (iseq (length (send self :stress-list)))
          (send self :stress-list) :color 'red)
    (send stressp :point-state (- (length (send self :stress-list)) 2) 'normal);pv
    (send stressp :point-state (- (length (send self :stress-list)) 1) 'selected);pv
    (send stressp :adjust-to-data)
    (send stressp :redraw)
    (send stressp :buffer-to-screen)))
;este método puede mejorarse para que al hacer las iteraciones no recalcule los analisis
;y sea mas rápido
(defmeth rmds-model-proto :update-plot-transformed-data ()
"This method recomputes the plot of transformed data and recomputes some values after acting upon the plots in the spreadplot"
  (let* (
         (pp (sixth (combine (send *current-spreadplot* :plot-matrix))))
         (data-list (send self :matrices-to-list (send self :t-data)))
         (D (distance-matrix (send self :X)))
         (dist-list (send self :matrices-to-list (list D)))
         (O (send self :data))
         (m (/ (length data-list) (length dist-list)))
         )
        (when (send self :monotone) 
          (setf results (send self :r-LSMTransform O D))
          (setf TO (first results))
          (send self :T-Data TO)
          (setf data-list (second results))
          (setf tran-list (third results))
          (setf dist-list (fourth results)))
    (send self :D D);this is necessary because distances have been recomputed
    (send pp :start-buffering)
    (send pp :clear-points)
    (if (send self :monotone)
        (send pp :add-points (list data-list dist-list)
              :color 'blue
              :symbol 'disk)
        (send pp :add-points (list data-list (repeat dist-list m))
              :color 'blue
              :symbol 'square))
    (when (send self :monotone) 
          (send pp :clear-lines)
          (send pp :add-lines data-list tran-list :color 'red))
    (send self :color-data-distances-plot pp)
    (send pp :adjust-to-data)
    
    (send pp :buffer-to-screen)
    ))

(defmeth rmds-model-proto :update-simple-plot-transformed-data (args)
	"This method recomputes the plot of transformed data when the procedure is iterating. It takes the arguments of the same iterating procedure"
  (let* (
         (pp (sixth (combine (send *current-spreadplot* :plot-matrix))))
         (data-list (first args))
         (dist-list (second args))
         (tran-list (third args))
         (m (/ (length data-list) (length dist-list)))
         )
    (send pp :start-buffering)
    (send pp :clear-points)
    (if (send self :monotone)
        (send pp :add-points (list data-list dist-list)
              :color 'blue
              :symbol 'square)
        (send pp :add-points (list data-list (repeat dist-list m))
              :color 'blue
              :symbol 'square))
    (when (send self :monotone) 
          (send pp :clear-lines)
          (send pp :add-lines data-list tran-list :color 'red))
    (send self :color-data-distances-plot pp)
    (send pp :adjust-to-data)
    (send pp :buffer-to-screen)
    ))

  (defmeth rmds-model-proto :color-data-distances-plot (pp)
    (let* (
           ;(pp (sixth (combine (send *current-spreadplot* :plot-matrix))))
           ;(pp *nrmds-fit/transf-plot*)
           (num-matrices (length (send self :data)))
           (dim-matrix (array-dimension (first (send self :data)) 0))
           (number-elements-matrix (/ (- (^ dim-matrix 2) dim-matrix) 2))
           (comp-color-16-list '((0 0 0) (0.25 0.25 0.25) (0.5 0.5 0.5) (0.75 0.75 0.75) 
                    (0.75 0.25 0.25) (0.5 0 0) (0 0.5 0) (0 1 0)
                    (0 1 1) (0 0 1) (0.5 0 0.5) (1 0 1) 
                    (1 0 0) (1 0.5 0.5) (1 1 0) (1 1 1)))

           (color-16-list (list 'c-16-1  'c-16-2  'c-16-3  'c-16-4
                          'c-16-5  'c-16-6  'c-16-7  'c-16-8
                          'c-16-9  'c-16-10 'c-16-11 'c-16-12
                          'c-16-13 'c-16-14 'c-16-15 'c-16-16))

           (list-16-colors
            (dotimes (i 16)
                    (setf comp-color-16 (nth i comp-color-16-list))
                    (make-color (nth i color-16-list) 
                     (nth 0 comp-color-16) (nth 1 comp-color-16) (nth 2 comp-color-16))))
           (list-6-colors (list 'blue  'magenta 'yellow 'green 'red  'cyan))
           )
      (when (and (> num-matrices 1) (<= num-matrices 6))
            (dotimes (i num-matrices)
                     (send pp :point-color 
                           (iseq (* i number-elements-matrix)
                                 (* (1+ i) number-elements-matrix))
                           (select list-6-colors i))))
      (when (and (> num-matrices 6) (<= num-matrices 16))
            (dotimes (i num-matrices)
                     (send pp :point-color 
                           (iseq (* i number-elements-matrix)
                                 (* (1+ i) number-elements-matrix))
                           (select color-16-list i))))
      (when (send self :monotone) 
            (when 
                   (and (> num-matrices 1) (<= num-matrices 6))        
                   (dotimes (i num-matrices)
                            (send pp :linestart-color 
                                  (iseq (* i number-elements-matrix)
                                        (* (1+ i) number-elements-matrix))
                                  (select list-6-colors i))
                            (when (> i 0)
                              (send pp :linestart-next 
                                    (1- (* i number-elements-matrix)) nil))
                            ))
                (when 
                 (and (> num-matrices 6) (<= num-matrices 16))
                 (dotimes (i num-matrices)
                          (send pp :linestart-color 
                                (iseq (* i number-elements-matrix)
                                      (* (1+ i) number-elements-matrix))
                                (select color-16-list i))
                          (when (> i 0)
                                (send pp :linestart-next 
                                    (1- (* i number-elements-matrix)) nil))
                            ))
            (send pp :redraw))
             
      ))